home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / codestsm / codest32.md_ / codest32.md / Procedures.json < prev    next >
Encoding:
JavaScript Object Notation  |  1996-08-13  |  10.4 KB
  1. {
  2.     "schema": {
  3.         "ID": "Long Integer",
  4.         "Name": "Text (80) NOT NULL",
  5.         "Description": "Memo/Hyperlink (255)",
  6.         "Code": "Memo/Hyperlink (255) NOT NULL"
  7.     },
  8.     "data": [
  9.         {
  10.             "ID": 3,
  11.             "Name": "GetSystemDirectory",
  12.             "Description": "Returns path of the Windows\\System directory.",
  13.             "Code": "'Declares for GetSystemDirectory\r\nDeclare Function GetSystemDirectory Lib \"kernel32\" Alias \"GetSystemDirectoryA\" (ByVal lpBuffer As String, ByVal nSize As Long) As Long\r\n\r\nFunction GetSysDir () As String\r\n    Dim sDir As String * 256\r\n    Dim ret&\r\n\r\n    ret = GetSystemDirectory(sDir, Len(sDir))\r\n    GetSysDir = Left$(sDir, ret)\r\n\r\nEnd Function"
  14.         },
  15.         {
  16.             "ID": 6,
  17.             "Name": "CalcLastPayment",
  18.             "Description": "Calculates last (uneven) payment with a remaining (or total) balance amount and payment amount. (Mod only works with integers)",
  19.             "Code": "Function CalcLastPmt (remaining As Currency, pmnt As Currency) As Currency\r\n   \r\n    Dim x As Single\r\n   \r\n    x = remaining / pmnt\r\n    x = Int(x)\r\n    CalcLastPmt = Format(remaining - (x * pmnt), \"standard\")\r\n   \r\nEnd Function"
  20.         },
  21.         {
  22.             "ID": 14,
  23.             "Name": "FloatWindow",
  24.             "Description": "Makes form/window whose handle is passed stay on top of others",
  25.             "Code": "'Declares for FloatWindow\r\nDeclare Function SetWindowPos Lib \"user32\" Alias \"SetWindowPos\" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long\r\nGlobal Const SWP_NOSIZE = &H1\r\nGlobal Const SWP_NOMOVE = &H2\r\nGlobal Const SWP_NOACTIVATE = &H10\r\nGlobal Const SWP_SHOWWINDOW = &H40\r\nGlobal Const HWND_TOPMOST = -1\r\nGlobal Const HWND_NOTOPMOST = -2\r\n\r\nSub Float (iHandle As Integer, bOnTop as Integer)\r\n   \r\nDim iFlags%, iPos%\r\n   \r\n    iFlags = SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE\r\n\r\n    Select Case bOnTop\r\n        Case True\r\n            iPos = HWND_TOPMOST\r\n        Case False\r\n            iPos = HWND_NOTOPMOST\r\n    End Select\r\n    \r\n    SetWindowPos iHandle, iPos, 0, 0, 0, 0, iFlags\r\n\r\nEnd Sub"
  26.         },
  27.         {
  28.             "ID": 15,
  29.             "Name": "CenterForm",
  30.             "Description": "Centers form on screen.",
  31.             "Code": "Sub CenterForm (frm As Form)\r\n    frm.Move (Screen.Width - frm.Width) / 2,  (Screen.Height - frm.Height) / 2\r\nEnd Sub"
  32.         },
  33.         {
  34.             "ID": 16,
  35.             "Name": "Get_INI",
  36.             "Description": "Gets INI settings from private INI file. Choose either GetPrivateProfileString or GetPrivateProfileInt and change values/data types as necessary.",
  37.             "Code": "'Declares for Get_INI\r\nDeclare Function GetPrivateProfileString Lib \"kernel32\" Alias \"GetPrivateProfileStringA\" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long\r\nDeclare Function GetPrivateProfileInt Lib \"kernel32\" Alias \"GetPrivateProfileIntA\" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long\r\n\r\nFunction Get_INI(sSection As String, sKey As String, sDefault As String, sNewSetting As String) As String\r\n \r\nDim sRetStr$\r\nDim iSize&, bRet&\r\n'Dim lValue&\r\n\r\n    sRetStr = Space$(128)\r\n    iSize = Len(iRetStr)\r\n    \r\n    ' use this for string values...Function return is string\r\n    bRet = GetPrivateProfileString(sSection, sKey, sDefault, sRetStr, iSize, \"INI Filename\")\r\n    Get_INI = Left$(sRetStr, bRet)\r\n       \r\n    ' use this for integer values---form.height, left & top position etc...change parameters & return data type \r\n    'bRet = GetPrivateProfileInt(sSection, sKey, lValue, \"INI Filename\")\r\n    'Get_INI = lValue\r\n\r\nEnd Function"
  38.         },
  39.         {
  40.             "ID": 17,
  41.             "Name": "Set_INI",
  42.             "Description": "Saves INI settings to private INI file",
  43.             "Code": "'Declares for Set_INI\r\nDeclare Function WritePrivateProfileString Lib \"kernel32\" Alias \"WritePrivateProfileStringA\" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long\r\n \r\nSub Set_INI (sSection As String, sKey As String, sNewSetting As String)\r\n\r\nDim bRet%\r\n\r\n    bRet = WritePrivateProfileString(sSection, sKey, sNewSetting, \"INI Filename\")\r\n\r\nEnd Sub"
  44.         },
  45.         {
  46.             "ID": 18,
  47.             "Name": "Pause",
  48.             "Description": "Pauses activity for set number of seconds",
  49.             "Code": "Sub Pause (Secs as Single)\r\n\r\nDim Start as Single\r\nDim Ret as Integer\r\n    \r\n    Start = Timer\r\n    While Timer < Start + Secs +1\r\n         Ret = DoEvents()\r\n    Wend\r\n\r\nEnd Sub"
  50.         },
  51.         {
  52.             "ID": 19,
  53.             "Name": "FileOpen",
  54.             "Description": "Opens text file in a text box",
  55.             "Code": "Sub FileOpen (Filename As String)\r\n\r\nDim F As Integer\r\n       \r\n    F = FreeFile\r\n    Open Filename For Input As F\r\n    Text1.Text = Input$(LOF(F), F)\r\n    Close F\r\n\r\nEnd Sub"
  56.         },
  57.         {
  58.             "ID": 20,
  59.             "Name": "FileClose",
  60.             "Description": "Closes a text file in a text box.",
  61.             "Code": "Sub FileClose (Filename As String)\r\n\r\nDim F As Integer\r\n    \r\n    F = FreeFile\r\n    Open Filename For Output As F\r\n    Print #F, Text1.Text    ' Print the current text to the opened file.\r\n    Close F\r\n    Filename = \"Untitled\" ' Reset the caption\r\n\r\nEnd Sub"
  62.         },
  63.         {
  64.             "ID": 21,
  65.             "Name": "FileSave",
  66.             "Description": "Saves a text file from a text box",
  67.             "Code": "Sub FileSave (Filename As String)\r\n\r\nDim sTxt As String\r\n\r\n    screen.MousePointer = 11\r\n    \r\n    ' open the file\r\n    Open Filename For Output As #1\r\n  \r\n    sTxt = Text1.Text\r\n    \r\n    ' write variable contents to saved file\r\n    Print #1, sTxt\r\n    Close #1\r\n    \r\n    screen.MousePointer = 0\r\n    \r\nEnd Sub"
  68.         },
  69.         {
  70.             "ID": 22,
  71.             "Name": "DayOfWeek",
  72.             "Description": "Finds day of week for a given date.",
  73.             "Code": "Function DayOfWeek (sDate as String) as String\r\n    Dim iDay as Integer\r\n   \r\n    iDay = DatePart(\"w\", sDate)\r\n    Select Case iDay\r\n        Case 1\r\n           DayOfWeek = \"Sunday\"\r\n        Case 2\r\n           DayOfWeek = \"Monday\"\r\n        Case 3\r\n            DayOfWeek = \"Tuesday\"\r\n        Case 4\r\n            DayOfWeek = \"Wednesday\"\r\n        Case 5\r\n            DayOfWeek = \"Thursday\"\r\n        Case 6\r\n            DayOfWeek = \"Friday\"\r\n        Case 7\r\n            DayOfWeek = \"Saturday\"\r\n\r\n     End Select   \r\n\r\nEnd Function"
  74.         },
  75.         {
  76.             "ID": 23,
  77.             "Name": "Add DateSeparator",
  78.             "Description": "Adds date separators, \"/\", to a 4, 5 or 6 digit number. Ex: 1196 becomes 01/01/96 and 11196 becomes 01/11/96 (not 11/01/96).",
  79.             "Code": "Function AddDateSeps(datestr As String) As String\r\n    \r\n    Dim x As Integer\r\n\r\n    AddDateSeps = \"\"\r\n\r\n    Select Case Len(Trim$(datestr))\r\n        Case 6\r\n            datestr = Mid$(datestr, 1, 2) & \"/\" & Mid$(datestr, 3, 2) & \"/\" & Mid$(datestr, 5, 2)\r\n        Case 5\r\n            datestr = 0 & datestr\r\n            datestr = Mid$(datestr, 1, 2) & \"/\" & Mid$(datestr, 3, 2) & \"/\" & Mid$(datestr, 5, 2)\r\n        Case 4\r\n            datestr = 0 & Mid$(datestr, 1, 1) & \"/\" & 0 & Mid$(datestr, 2, 1) & \"/\" & Mid$(datestr, 3, 2)\r\n    End Select\r\n\r\n    AddDateSeps = datestr\r\n\r\nEnd Function"
  80.         },
  81.         {
  82.             "ID": 24,
  83.             "Name": "SystemDateFormat",
  84.             "Description": "Checks WIN.INI for system date format.",
  85.             "Code": "Function DateFormat () As Integer\r\n   \r\nDim Buffer As String\r\nDim DateInfo As String\r\nDim r As Integer\r\n\r\n    Buffer = Space(128)\r\n\r\n    r = GetProfileString(\"intl\", \"sShortDate\", \"\", Buffer, Len(Buffer))\r\n    DateInfo = Left$(Buffer, r)\r\n\r\n    If Left$(DateInfo, 2) = \"MM\" Then\r\n       DateFormat = 1 'MM/dd/yy\r\n    Else\r\n       DateFormat = 2 'dd/MM/yy\r\n    End If\r\n\r\nEnd Function"
  86.         },
  87.         {
  88.             "ID": 25,
  89.             "Name": "SetPaymentNumbers",
  90.             "Description": "Takes a balance amount and payment amount to set number of payments.",
  91.             "Code": "Function SetPaymentNum (pmt As Currency, bal as Currency) As Integer\r\n \r\n    If bal > 0 Then\r\n        If bal Mod pmt Then\r\n            SetPaymentNum = Int((bal / pmt) + 1))\r\n        Else\r\n            SetPaymentNum = bal / pmt\r\n        End If\r\n    End If\r\n\r\nEnd Function"
  92.         },
  93.         {
  94.             "ID": 26,
  95.             "Name": "FileExists",
  96.             "Description": "Tries to open file to determine if file exists",
  97.             "Code": "Function FileExists (fname as String) As Integer\r\n    Dim n\r\n    n = FreeFile\r\n\r\n    On Error Resume Next\r\n    Open fname For Input As n\r\n    If Err = 0 Then\r\n        FileExists = True\r\n    Else\r\n        FileExists = False\r\n    End If\r\n    Close n\r\n\r\nEnd Function"
  98.         },
  99.         {
  100.             "ID": 27,
  101.             "Name": "FileExists2",
  102.             "Description": "Checks file length to determine if a file exists.",
  103.             "Code": "Function FileExists2(fname as String) as Integer\r\n\r\nDim n&\r\n    On Error Resume Next\r\n    n = FileLen(fname)\r\n    If n Then File_Exists = True\r\n\r\nEnd Function"
  104.         },
  105.         {
  106.             "ID": 28,
  107.             "Name": "HiLiteText",
  108.             "Description": "Highlights the text in a text box when it receives the focus",
  109.             "Code": "Sub HiliteText (cTxtBox As Control)\r\n\r\n    cTxtBox.SelStart = 0\r\n    cTxtBox.SelLength = 65000\r\n\r\nEnd Sub"
  110.         },
  111.         {
  112.             "ID": 29,
  113.             "Name": "GetWindowsDirectory",
  114.             "Description": "Returns path of the Windows directory.",
  115.             "Code": "'Declares for GetWindowsDirectory\r\nDeclare Function GetWindowsDirectory Lib \"kernel32\" Alias \"GetWindowsDirectoryA\" (ByVal lpBuffer As String, ByVal nSize As Long) As Long\r\n\r\nFunction GetWinDir() As String\r\n\r\n    Dim sDir As String * 256\r\n    Dim ret%\r\n\r\n    ret = GetWindowsDirectory(sDir, Len(sDir))\r\n    GetWinDir = Left$(sDir, ret)\r\n\r\nEnd Function"
  116.         },
  117.         {
  118.             "ID": 31,
  119.             "Name": "FileSaveAs",
  120.             "Description": "Calls common dialog control box (SaveAs) to save new text file from text box.\r\nAlso requires FileExists procedure to test for existing filename.",
  121.             "Code": "Sub FileSaveAs()\r\n\r\nDim sTxt$, sFilename$\r\nDim iRet%\r\n\r\n    On Error GoTo errFileSaveAs\r\n    screen.MousePointer = 11\r\n\r\n    CDialog1.Filename = \"\"\r\n    CDialog1.Filter = \"Text Files(*.txt)|*.txt|All Files (*.*)|*.*|\"\r\n    CDialog1.ShowSave\r\n    \r\n    sFilename = CDialog1.Filename\r\n    If sFilename <> \"\" Then\r\n        iRet = FileExists(sFilename)\r\n        If iRet Then\r\n            iRet = MsgBox(\"This file already exists. Do you want to overwrite it?\", vbYesNo + vbQuestion, Me.Caption)\r\n            If iRet = vbNo Then\r\n               screen.MousePointer = 0\r\n               Exit Sub\r\n            End If\r\n        End If\r\n    End If\r\n    \r\n    ' open the file\r\n    Open sFilename For Output As #1\r\n    \r\n    sTxt = Text1.Text\r\n    \r\n   ' write variable contents to saved file\r\n    Print #1, sTxt\r\n    Close #1\r\n    \r\n    Screen.MousePointer = 0\r\n    \r\nerrFileSaveAs:\r\n    If Err = cdlCancel Then\r\n        Screen.MousePointer = 0\r\n        Exit Sub\r\n    Else\r\n        ' handle other errors\r\n    End If\r\n\r\nEnd Sub"
  122.         }
  123.     ]
  124. }